perm filename M11X.F4[M11,LCS]1 blob
sn#375378 filedate 1978-08-18 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CPASS3 PASS 3 MAIN PROGRAM
C00014 ENDMK
Cā;
CPASS3 PASS 3 MAIN PROGRAM
C *** MUSIC V ***
INTEGER PEAK,CONV
CXX DOUBLE PRECISION JFLNM,JTRNS,JBLA
DIMENSION T(50),TI(50),ITI(50)
CSS COMMON I(513) /P/P(50)/PARM/IP(20)/FINOUT/PEAK,RPEAK,NBUF
COMMON I(513) /P/P(50) /FINOUT/PEAK,RPEAK,NBUF
1 /GENS/GENS(3072) /IRAN/IRAN /CONV/CONV,INIOUT,JFLNM
1 /LFUNC/LFUNC /IFIRST/IFIRST,IDT
C NOPCD=NUM.OF OP CODES, ISRT=DEFAULT SMPL.RATE, LFUNC=FUNC ARRAY LENGTH,
DATA NOPCD/14/, ISRT/10000/, LFUNC/512/
1 , NPAR/35/, NINS/27/, LBLK/512/
C NPAR=NUM. OF PARAMS/INST., NINS=NUM. OF INSTS., LBLK=LENGTH OF OUTPUT BLOCKS
COMMON /INS/INS(400),IDEF(100) /NT/RNT(1000) /ROUT/ROUT(3072)
C INS=INSTRUMENT DEFINITIONS, IDEF=LOCATION TABLE, ROUT=OUTPUT BLOCK (B1āB6)(6*512)
EQUIVALENCE (I2,I(2)),(T3,T(3)),(T2,T(2)),(P3,P(3))
1, (I5,I(5)),(I6,I(6))
DATA JTRNS/'TRNS '/,JBLA/' '/
DATA IIIRD/976545367/
C INIALIZATION OF PIECE
C IIIRD - ARBITRARY STARTING NUMBER FOR SUBROUTINE RANDU
CXX IRAN=32767
CXX IRAN=I(7)+1
IRAN=IIIRD
NBUF=512
CC******* NREAD = 3
CC******* NWRITE = 2
NREAD=21
C PDP DSK1=DEV.21
NWRITE=1
C PDP DSK=DEV.1
CXX REWIND NREAD
CXX REWIND NWRITE
CZZ44 TYPE 401
CZZ ACCEPT 501,JFLNM,CONV
C TYPE <CR> FOR DEFAULT NAME(FOR21.DAT), ADD A NUM. TO WRITE SMPLS TO BE PLAYED.
CC IF(JFLNM.EQ.JBLA)JFLNM=JTRNS
CXX CALL OPEN(21,JFLNM,0,'RDO',,,'UNF')
CZZ CALL IFILE(21,JFLNM)
C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
401 FORMAT(' TYPE FILE NAME'/)
501 FORMAT(A5,5I)
1000 INIOUT=-1
C INIOUT IS TO INITIALIZE OUTPUT SYSTEM.
IFIRST=-1
IDT=1
C ABOVE 2 ARE IN TRANS. ROUTINES.
PEAK=0
CSS IPEAK=0
RPEAK=0
C IPEAK AND PEAK USED TO TYPE OUT AMPL. INFO. LATER.
I2=1
MS1=1
MS3=MS1+(NPAR*NINS)-1
MS2=NPAR
I(4)=ISRT
MOUT=1
C INITIALIZATION OF SECTION
5 T(1)=0.0
DO 220 N1=MS1,MS3,MS2
C INITS POSSIBLE NUM OF NOTES THAT CAN PLAY AT ONCE (27 NOW)
220 RNT(N1)=-1
DO 221 N1=1,NINS
221 TI(N1)=90909.
C MAIN CARD READING LOOP
204 CALL DATA (NREAD)
IF(P(2)-T(1))200,200,244
200 IOP=P(1)
IF(IOP)201,201,202
201 CALL ERROR(1)
GO TO 204
202 IF(NOPCD-IOP)201,203,203
203 GO TO (1,2,3,4,5,6,201,201,201,201,11,11),IOP
11 IVAR=P3
IVARE=IVAR+I(1)-4
DO 297 N1=IVAR,IVARE
IVARP=N1-IVAR+4
297 I(N1)=P(IVARP)
C I HOLDS THINGS LIKE SRATE, NCHNS (CHA)
IF(N1.EQ.8)NBUF=512+512*I(N1)
C SET BUFFER SIZE . (512=MONO, 1024=STEREO)
GO TO 204
3 IGEN=P3
IF(IGEN.NE.1)GO TO 282
CCC **** ONLY GEN1,GEN2 IN THIS VERSION GO TO (281,282,283,284,285),IGEN
281 CALLGEN1
GO TO 204
282 IF(IGEN.GT.2)PAUSE ' ONLY GEN1 AND GEN2 FOR NOW'
CALLGEN2
GO TO 204
4 IVAR=P3
IVARE=IVAR+I(1)-4
DO 296N1=IVAR,IVARE
IVARP=N1-IVAR+4
296 I(N1+100)=P(IVARP)
GO TO 204
6 CALL FROUT3(IDSK)
CCCC STOP
GO TO 1000
C ENTER NOTE TO BE PLAYED
1 DO 230N1=MS1,MS3,MS2
230 IF(RNT(N1).EQ.-1)GO TO 231
CALL ERROR(2)
C TOO MANY NOTES(27 LIMIT FOR NOW) TRYING TO PLAY AT ONCE.
TYPE 1230,NINS
GO TO 204
1230 FORMAT(' TOO MANY NOTES AT ONCE. LIMIT=',I2/)
231 M1=N1
M2=N1+I(1)-1
M3=M2+1
M4=N1+NPAR-1
DO 232N1=M1,M2
M5=N1-M1+1
232 RNT(N1)=P(M5)
RNT(M1 )=P3
DO 233N1=M3,M4
233 RNT(N1)=0
DO 235N1=1,NINS
IF(TI(N1)-90909.)235,234,235
234 TI(N1)=P(2)+P(4)
ITI(N1)=M1
GO TO 204
235 CONTINUE
CALL ERROR(3)
GO TO 204
C DEFINE INSTRUMENT
2 M1=I2
M2=IFIX(P3)
IDEF(M2)=M1
218 CALL DATA (NREAD)
IF(I(1)-2)210,210,211
210 INS(M1)=0
I2=M1+1
GO TO 204
211 INS(M1)=P3
M3=I(1)
INS(M1+1)=M1+M3-1
M1=M1+2
DO 217N1=4,M3
M5=P(N1)
IF(M5)212,213,213
212 IF(M5+100)300,301,301
300 INS(M1)=-1+(M5+101)*LFUNC
GO TO 216
301 INS(M1)=-1+(M5+1)*LBLK
GO TO 216
213 IF(M5- 100 )214,214,215
214 INS(M1)=M5
GO TO 216
215 INS(M1)=M5+26262
C****** WHAT DOES THIS BIG NUM.(2**18) DO?? ***********
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
216 M1=M1+1
217 CONTINUE
GO TO 218
C PLAY TO ACTION TIME
244 T2=P(2)
250 TMIN=90909.
IREST=1
DO 241N1=1,NINS
IF(TMIN-TI(N1))241,241,240
240 TMIN=TI(N1)
MNOTE=N1
241 CONTINUE
IF(90909.-TMIN)251,251,243
243 IF(TMIN-T2)245,245,246
245 T3=TMIN
GO TO 260
246 T3=T2
GO TO 260
247 IF(T(1)-T2)249,200,200
249 TI(MNOTE)=90909.
M2=ITI(MNOTE)
RNT(M2)=-1
GO TO 250
C SETUP REST
251 T3=T2
IREST=2
GO TO 260
C PLAY
260 ISAM=(T3-T(1))*FLOAT(I(4))+.5
T(1)=T3
IF(ISAM)247,247,266
266 IF(ISAM-LBLK)262,262,263
262 I5=ISAM
ISAM=0
GO TO 264
263 I5=LBLK
ISAM=ISAM-LBLK
264 IF(I(8))290,290,291
290 M3=MOUT+I5-1
MSAMP=I5
GO TO 292
291 M3=MOUT+(2*I5)-1
MSAMP=2*I5
292 DO 267N1=MOUT,M3
267 ROUT(N1)=0
GO TO (268,265),IREST
268 DO 270 NS1=MS1,MS3,MS2
IF(RNT(NS1)+1)271,270,271
C GO THROUGH UNIT GENERATORS IN INSTRUMENT
271 I(3)=NS1
IGEN=RNT(NS1)
IGEN=IDEF(IGEN)
272 I6=IGEN
294 CALL FORSAM
295 IGEN=INS(IGEN+1)
IF(INS(IGEN))270,270,272
270 CONTINUE
265 CALL SAMOUT(IDSK ,MSAMP)
IF(ISAM)247,247,266
END
CDATA3 PASS 3 DATA INPUTING ROUTINE
SUBROUTINE DATA (N)
COMMON I(1)/P/ P(1) /FINOUT/PEAK,RPEAK /IFIRST/IFIRST,IDT
CSS COMMON I(1)/P/ P(1) /FINOUT/JPEAK,IPEAK
EQUIVALENCE (K,I),(P2,P(2))
CALL TRANS(IDT)
CZZ READ (N) K,(P(J),J=1,K)
IF(P(1).EQ.1)TYPE 1,P2
IF(PEAK.LE.RPEAK)RETURN
CSS IF(JPEAK.LE.IPEAK)RETURN
TYPE 2,PEAK
CSS TYPE 2,JPEAK
RPEAK=PEAK
CSS IPEAK=JPEAK
C TYPES OUT EACH NEW PEAK AMPL.
RETURN
1 FORMAT('+',F9.2,$)
2 FORMAT('+ AMPL=',F5.0,$)
CSS2 FORMAT('+ AMPL=',I4,$)
END
SUBROUTINE FROUT3(IDSK)
C TERMINATE OUTPUT
COMMON /ROUT/ROUT(1) /FINOUT/PEAK /CONV/CONV
CC 1 /IFIRST/IFIRST,IDT
CC IFIRST=-1
CC IDT=0
C THE ABOVE ARE RESETS TO GET BACK TO 'INPUT?'
DO 1 K=1,512
1 ROUT(K)=0
CALL SAMOUT(IDSK,512)
TYPE 10,PEAK
C NOW CLOSE OFF THE FILE
IF(CONV.NE.0)GO TO 3
END FILE 23
RETURN
3 CALL FINFIL
TYPE 2
RETURN
2 FORMAT(' 11.DMD WAS WRITTEN ********')
10 FORMAT ('0PEAK AMPLITUDE WAS ',F7.0)
END